2ª Análise com os dados ‘Sikora_Complete.txt’
Breve Resumo
Neste arquivo constam os resultados da segunda análise com os dados de “Sikora_complete.txt”. A seguir, está a descrição dos procedimentos:
- utilizou-se apenas o algoritmo de agrupamento (EM - GMM) do pacote MClust;
- nos plots, fora empregada a caracterização de \(R \ge 1\) ou \(<1\);
- os algoritmos foram rodados considerando todas as variaveis inicialmente;
- realizou-se análise de componentes principais;
- confeccionou-se um GIF parar verificar como os dados estariam separados nas respectivas dimensões;
- repetiu-se o algoritmo de agrupamento apenas para as variáveis Core e B_Band, considerando a característica de \(R \ge 1\) ou \(<1\).
Resultados
load("~/WKSPCE_analise2_sikora.RData")Primeiramente plotamos os pares de variáveis com a caracterização relativa a \(R \ge 1\) ou \(<1\) para as observações. Destaca-se o segundo gráfico Core vs B_Band, com o aspecto de duas diagonais bem definidas segundo o valor do \(R\).
#leitura
# sikora.loc <- file.choose()
# sikora.df <- read.table(sikora.loc, header=TRUE)
#str(sikora.df)
# criando fator
sikora.df$R1 <- (sikora.df$R >= 1)
sikora.df$R1 <- ifelse(sikora.df$R1 == TRUE, "R>1", "R<1")
#plotando
#install.packages("gridExtra")
library(ggplot2)
library(gridExtra)
# para pegar e passar os nomes das variaveis corretamente para o ggplot
comb = combn(ncol(sikora.df[,1:4]),2)
p = list()
nomes <- colnames(sikora.df[1:4])
comb_nomes <- matrix(NA, nrow=2, ncol=ncol(comb))
comb_nomes <- sapply(1:ncol(comb),function(j){
sapply(1:2,function(i){
comb_nomes[i,j]<-nomes[comb[i,j]]
})
})
p <- sapply(1:length(comb), function(i){
apply(comb_nomes, 2, function(x){
p[i] <- ggplot(sikora.df, aes_string(x[1], x[2]))+
geom_point(aes(colour = R1), size = 1.5)+
ggtitle("Comparação R>1 e R<1")+
theme(plot.title = element_text(hjust=0.5))
})
})
#ok!
grid.arrange(p[[1]],p[[2]],p[[3]],p[[4]],p[[5]],p[[6]], ncol=3)
Em seguida, rodamos o GMM do pacote MClust para as 4 variáveis (Core, Lobe, B_Band e Mass ) sem restrição quanto ao número de grupos. O modelo ideal seria o com \(4\) grupos, conforme se verifica da tabela e do gráfico de BIC’s.
#rodando MClust
### G irrestrito
library(mclust)
library(factoextra)
out1 <- Mclust(sikora.df[,1:4])
#str(out1)
summary(out1$BIC)## Best BIC values:
## VEV,4 EEV,4 EEV,6
## BIC -2269.529 -2284.99798 -2300.63019
## BIC diff 0.000 -15.46928 -31.10149fviz_mclust_bic(out1)
Em seguida, recuperamos essa classificação para os pares de variáveis, ainda mantendo o shape diferenciado para o valor do \(R\).
# levando a classificação para os dados originais
sikora.df$cluster1 <- as.factor(out1$classification)
p <- sapply(1:length(comb), function(i){
apply(comb_nomes, 2, function(x){
p[i] <- ggplot(sikora.df, aes_string(x[1], x[2]))+
geom_point(aes(colour = cluster1, shape=R1), size = 1.5)+
#ggtitle("Comparação R>1 e R<1")+
theme(plot.title = element_text(hjust=0.5))
})
})
#x11()
grid.arrange(p[[1]],p[[2]],p[[3]],p[[4]],p[[5]],p[[6]], ncol=3)
O próximo passo consistiu em rodar o GMM fixando em 2 grupos. As classificações são aprensentadas abaixo para cada par de variáveis. Ressalta-se não haver evidência dos clusters “diagonais” no caso Core vs B_Band assim como na primeira análise preliminar.
### G=2
out2 <- Mclust(sikora.df[,1:4], G=2)
#str(out2)
#summary(out2$BIC)
#fviz_mclust_bic(out2)
# levando a classificação para os dados originais
sikora.df$cluster2 <- as.factor(out2$classification)
p <- sapply(1:length(comb), function(i){
apply(comb_nomes, 2, function(x){
p[i] <- ggplot(sikora.df, aes_string(x[1], x[2]))+
geom_point(aes(colour = cluster2, shape=R1), size = 1.5)+
#ggtitle("Comparação R>1 e R<1")+
theme(plot.title = element_text(hjust=0.5))
})
})
#x11()
grid.arrange(p[[1]],p[[2]],p[[3]],p[[4]],p[[5]],p[[6]], ncol=3)
Na Análise de Componentes Principais nota-se o grande peso da componente 1 na explicação da variabilidade dos dados. Nesta componente, a variável Lobe explica toda a variabilidade. Passando à componente dois, constata-se principalmente o “carregamento” de Core e B_Band, que serão analisadas de forma separada posteriormente (repetindo-se a primeira análise realizada para os dados sikora).
#PCA:
pca<-princomp(sikora.df[,1:4])
summary(pca)## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4
## Standard deviation 12.1941450 2.3367059 1.182165341 0.53013870
## Proportion of Variance 0.9541906 0.0350381 0.008967861 0.00180348
## Cumulative Proportion 0.9541906 0.9892287 0.998196520 1.00000000pca$loadings##
## Loadings:
## Comp.1 Comp.2 Comp.3 Comp.4
## Core 0.725 0.608 -0.323
## Lobe -1.000
## B_Band 0.662 -0.744
## Mass 0.188 0.276 0.943
##
## Comp.1 Comp.2 Comp.3 Comp.4
## SS loadings 1.00 1.00 1.00 1.00
## Proportion Var 0.25 0.25 0.25 0.25
## Cumulative Var 0.25 0.50 0.75 1.00#install.packages("ggfortify")
#http://rpubs.com/sinhrks/plot_pca
library(ggfortify)
autoplot(pca)
biplot(pca)
Essa separação verificada na PCA pode ser melhor notada no GIF abaixo confeccionado com o pacote \(tourr\):
#tourr
library(tourr)
animate(sikora.df[,1:4],
grand_tour(d = 2), display = display_xy())